// ------------------------------------------------------------------------------
//
// HSL - RGB colour model conversions
//
// These four functions can be used to convert between the RGB and HSL colour
// models.  RGB values are represented using the 0-255 Windows convention and
// always encapsulated in a TColor 32 bit value.  HSL values are available as
// either 0 to 1 floating point (double) values or as a 0 to a defined integer
// value.  The colour common dialog box uses 0 to 240 by example.
//
// The code is based on that found (in C) on:
//
// http:/www.r2m.com/win-developer-faq/graphics/8.html
//
// Grahame Marsh 12 October 1997
//
// Freeware - you get it for free, I take nothing, I make no promises!
//
// Please feel free to contact me: grahame.s.marsh@corp.courtaulds.co.uk
//
// Revison History:
// Version 1.00 - initial release  12-10-1997
//
// ------------------------------------------------------------------------------

unit HSLUtils;

interface

uses
  Windows, Graphics;

var
  HSLRange: integer = 240;

  // convert a HSL value into a RGB in a TColor
  // HSL values are 0.0 to 1.0 double
function HSLtoRGB(H, S, L: double): TColor;

// convert a HSL value into a RGB in a TColor
// SL values are 0 to the HSLRange variable
// H value is to HSLRange-1
function HSLRangeToRGB(H, S, L: integer): TColor;

// convert a RGB value (as TColor) into HSL
// HSL values are 0.0 to 1.0 double
procedure RGBtoHSL(RGB: TColor; var H, S, L: double);

// convert a RGB value (as TColor) into HSL
// SL values are 0 to the HSLRange variable
// H value is to HSLRange-1
procedure RGBtoHSLRange(RGB: TColor; var H, S, L: integer);

implementation

function HSLtoRGB(H, S, L: double): TColor;
var
  M1, M2: double;

  function HueToColourValue(Hue: double): byte;
  var
    V: double;
  begin
    if Hue < 0 then
      Hue := Hue + 1
    else if Hue > 1 then
      Hue := Hue - 1;

    if 6 * Hue < 1 then
      V := M1 + (M2 - M1) * Hue * 6
    else if 2 * Hue < 1 then
      V := M2
    else if 3 * Hue < 2 then
      V := M1 + (M2 - M1) * (2 / 3 - Hue) * 6
    else
      V := M1;
    Result := round(255 * V)
  end;

var
  R, G, B: byte;
begin
  if S = 0 then
  begin
    R := round(255 * L);
    G := R;
    B := R
  end
  else
  begin
    if L <= 0.5 then
      M2 := L * (1 + S)
    else
      M2 := L + S - L * S;
    M1 := 2 * L - M2;
    R := HueToColourValue(H + 1 / 3);
    G := HueToColourValue(H);
    B := HueToColourValue(H - 1 / 3)
  end;

  Result := RGB(R, G, B)
end;

function HSLRangeToRGB(H, S, L: integer): TColor;
begin
  Result := HSLtoRGB(H / (HSLRange - 1), S / HSLRange, L / HSLRange)
end;

// Convert RGB value (0-255 range) into HSL value (0-1 values)

procedure RGBtoHSL(RGB: TColor; var H, S, L: double);

  function Max(a, B: double): double;
  begin
    if a > B then
      Result := a
    else
      Result := B
  end;

  function Min(a, B: double): double;
  begin
    if a < B then
      Result := a
    else
      Result := B
  end;

var
  R, G, B, D, Cmax, Cmin: double;
begin
  R := GetRValue(RGB) / 255;
  G := GetGValue(RGB) / 255;
  B := GetBValue(RGB) / 255;
  Cmax := Max(R, Max(G, B));
  Cmin := Min(R, Min(G, B));

  // calculate luminosity
  L := (Cmax + Cmin) / 2;

  if Cmax = Cmin then // it's grey
  begin
    H := 0; // it's actually undefined
    S := 0
  end
  else
  begin
    D := Cmax - Cmin;

    // calculate Saturation
    if L < 0.5 then
      S := D / (Cmax + Cmin)
    else
      S := D / (2 - Cmax - Cmin);

    // calculate Hue
    if R = Cmax then
      H := (G - B) / D
    else if G = Cmax then
      H := 2 + (B - R) / D
    else
      H := 4 + (R - G) / D;

    H := H / 6;
    if H < 0 then
      H := H + 1
  end
end;

procedure RGBtoHSLRange(RGB: TColor; var H, S, L: integer);
var
  Hd, Sd, Ld: double;
begin
  RGBtoHSL(RGB, Hd, Sd, Ld);
  H := round(Hd * (HSLRange - 1));
  S := round(Sd * HSLRange);
  L := round(Ld * HSLRange);
end;

end.
